home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_pas / tsfaqp31.zip / FAQPAS4.TXT < prev    next >
Text File  |  1996-04-28  |  41KB  |  1,120 lines
  1. From ts@uwasa.fi Sun Apr 28 00:00:00 1996
  2. Subject: FAQPAS4.TXT contents
  3.  
  4.                                Copyright (c) 1993-1996 by Timo Salmi
  5.                                                  All rights reserved
  6.  
  7. FAQPAS4.TXT The fourth set of frequently (and not so frequently)
  8. asked Turbo Pascal questions with Timo's answers. The items are in
  9. no particular order.
  10.  
  11. You are free to quote brief passages from this file provided you
  12. clearly indicate the source with a proper acknowledgment.
  13.  
  14. Comments and corrections are solicited. But if you wish to have
  15. individual Turbo Pascal consultation, please post your questions to
  16. a suitable Usenet newsgroup like news:comp.lang.pascal.borland. It
  17. is much more efficient than asking me by email. I'd like to help,
  18. but I am very pressed for time. I prefer to pick the questions I
  19. answer from the Usenet news. Thus I can answer publicly at one go if
  20. I happen to have an answer. Besides, newsgroups have a number of
  21. readers who might know a better or an alternative answer. Don't be
  22. discouraged, though, if you get a reply like this from me. I am
  23. always glad to hear from fellow Turbo Pascal users.
  24.  
  25. ....................................................................
  26. Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
  27. Moderating at ftp:// & http://garbo.uwasa.fi archives  193.166.120.5
  28. Department of Accounting and Business Finance  ; University of Vaasa
  29. ts@uwasa.fi http://uwasa.fi/~ts BBS 961-3170972; FIN-65101,  Finland
  30.  
  31. --------------------------------------------------------------------
  32. 76) What are the current Pascal newsgroups on the Usenet news?
  33. 77) How do I detect the CapsLock status, how do I turn it on/off?
  34. 78) How do I detect if the F11 or F12 key has been pressed?
  35. 79) How do I extract (parse) substrings from an input string?
  36. 80) How do I find out the size of any kind of a file?
  37. 81) How do I format graphics output like in textmode writeln?
  38. 82) How do I detect if more than one standard key is pressed down?
  39. 83) How can I read a disk's Volume Serial Number?
  40. 84) How can I disable and then enable the keyboard in my TP program?
  41. 85) How do I get the character device name of the (first) CD-ROM?
  42. 86) How do I eject a CD-ROM using a Turbo Pascal program?
  43. 87) How do I find out if the ANSI.SYS driver has been loaded?
  44. 88) Where do I find Turbo Pascal tutorials and/or good textbooks?
  45. 89) How do I make an executable of my Turbo Pascal source program?
  46. 90) How can I quickly read the last byte of a file?
  47. 91) Is 2000 a leap year? What is the leap year algorithm?
  48. 92) Does anybody have a program that gives the week number?
  49. 93) How can I use OutText to write numbers in the graphics mode?
  50. 94) How can I redirect output to file if I use the Crt unit?
  51. 95) How to write a function to return true if I am in graphics mode?
  52. --------------------------------------------------------------------
  53.  
  54. From ts@uwasa.fi Sun Apr 28 00:01:16 1996
  55. Subject: Usenet Pascal newsgroups
  56.  
  57. 76. *****
  58.  
  59.  Q: What are the current Pascal newsgroups on the Usenet news?
  60.  
  61.  A: The following new Pascal newsgroups were created June 12, 1995
  62. to replace the old comp.lang.pascal. The new Delphi newsgroups were
  63. first created around July 10, 1995. Further Delphi newsgroups were
  64. added in April 1996.
  65.  
  66. A special note about Delphi postings. Please use the delphi
  67. newsgroups for the Delphi related postings. In particular, the
  68. newsgroup comp.lang.pascal.borland is _NOT_ for Delphi related
  69. subjects!
  70.  
  71. A second special note. Please avoid crossposting between the
  72. newsgroups. In particular do not crosspost between the old and the
  73. new newsgroups. It slows the transition to the new system. (This
  74. automatic posting breaches the general non-crossposting tenet only
  75. because it is relevant information about the arrangements of all the
  76. newsgroups involved.)
  77.  
  78. CURRENT:
  79.  comp.lang.pascal.ansi-iso Pascal according to ANSI and ISO standards.
  80.  comp.lang.pascal.borland  Borland's Pascal incl. Turbo Pascal (not Delphi!)
  81.  comp.lang.pascal.mac      Macintosh based Pascals.
  82.  comp.lang.pascal.misc     Pascal in general and ungrouped Pascals.
  83.  
  84.  comp.lang.pascal.delphi.advocacy Contentious issues related to Delphi.
  85.  comp.lang.pascal.delphi.announce Delphi related announcements. (Moderated)
  86.  comp.lang.pascal.delphi.components.misc General component issues.
  87.  comp.lang.pascal.delphi.components.usage Using pre-written components.
  88.  comp.lang.pascal.delphi.components.writing Writing Delphi components.
  89.  comp.lang.pascal.delphi.databases Database aspects of Borland Delphi.
  90.  comp.lang.pascal.delphi.misc General issues with Borland Delphi.
  91.  comp.sources.delphi Delphi and ObjectPascal source code. (Moderated)
  92.  
  93. RELATED of potential interest:
  94. comp.os.msdos.programmer.turbovision Borland's text application libraries
  95.  
  96. OLD:  Please cease using!
  97.  comp.lang.pascal                     Discussion about Pascal.
  98.  comp.lang.pascal.delphi.components   Writing components in Borland Delphi.
  99.  
  100. For more information about the Pascal newsgroups please see
  101.  
  102.  52703 Jun 14 1995 ftp://garbo.uwasa.fi/pc/doc-net/pasgroup.zip
  103.  pasgroup.zip Information about the comp.lang.pascal.* newsgroups
  104.  
  105. If your site is not getting the new Pascal newsgroups, please
  106. contact your own site's newsmaster about the situation.
  107. --------------------------------------------------------------------
  108.  
  109. From ts@uwasa.fi Sun Apr 28 00:01:17 1996
  110. Subject: Capslock status and toggling
  111.  
  112. 77. *****
  113.  Q: How do I detect the CapsLock status, how do I turn it on/off?
  114.  
  115.  A: Here are the relevant Turbo Pascal routines in answer to these
  116. questions.
  117.   {}
  118.   Uses Dos;  { The Dos unit is needed }
  119.   {}
  120.   (* Is CapsLock on *)
  121.   function CAPSONFN : boolean;
  122.   var regs      : registers;
  123.       KeyStatus : byte;
  124.   begin
  125.     FillChar (regs, SizeOf(regs), 0);
  126.     regs.ax := $0200;      { Get shift flags }
  127.     Intr ($16, regs);      { The keyboard interrupt }
  128.     KeyStatus := regs.al;  { AL = shift status bits }
  129.     if (KeyStatus and $40) > 0 then         { bit 6 }
  130.       capsonfn := true
  131.     else
  132.       capsonfn := false;
  133.   end;  (* capsonfn *)
  134.   {}
  135.   (* Set CapsLock. Use true to turn on, false to turn off *)
  136.   procedure CAPS (TurnOn : boolean);
  137.   var keyboardStatus : byte absolute $0040:$0017;
  138.       regs           : registers;
  139.   begin
  140.     if TurnOn then
  141.        keyboardStatus := keyboardStatus or $40
  142.      else
  143.        keyboardStatus := keyboardStatus and $BF;
  144.     { Interrrupt "check for keystroke" to ensure the LED status }
  145.     FillChar (regs, SizeOf(regs), 0);
  146.     regs.ah := $01;
  147.     Intr ($16, regs);
  148.   end;  (* caps *)
  149.   {}
  150. As you see, CapsLock is indicated by bit 6. The other toggles can be
  151. handled in an equivalent way using this information about the memory
  152. location Mem[$0040:$0017]:
  153.   ScrollLock = bit 4      $10  $EF
  154.   NumLock    = bit 5      $20  $DF
  155.   CapsLock   = bit 6      $40  $BF
  156. --------------------------------------------------------------------
  157.  
  158. From ts@uwasa.fi Sun Apr 28 00:01:18 1996
  159. Subject: Detecting F11 and F12
  160.  
  161. 78. *****
  162.  Q: How do I detect if the F11 or F12 key has been pressed?
  163.  
  164.  A: Here is a sample program
  165.   uses Dos;
  166.   (* Enhanced keyboard ReadKey, no Crt unit needed. Detects also F11
  167.      and F12, and distinguishes between the numeric keypad and the
  168.      gray keys. Lower part of the word returns the first scan code,
  169.      the higher part the second *)
  170.   function RDENKEFN : word;
  171.   var regs     : registers;
  172.       keyboard : byte absolute $40:$96;
  173.   begin
  174.     rdenkefn := 0;
  175.     if ((keyboard shr 4) and 1) = 0 then exit;
  176.     FillChar (regs, SizeOf(regs), 0);
  177.     regs.ah := $10;
  178.     Intr ($16, regs);
  179.     rdenkefn := regs.ax;
  180.   end;  (* rdenkefn *)
  181.   {}
  182.   procedure TEST;
  183.   var key : word;
  184.   begin
  185.     while Lo(key) <> 27 do  { esc exits }
  186.       begin
  187.         key := RDENKEFN;
  188.         if (Lo(key) = 0) and (Hi(key) = 133) then
  189.           writeln ('F11 was pressed');
  190.         if (Lo(key) = 0) and (Hi(key) = 134) then
  191.           writeln ('F12 was pressed');
  192.       end;
  193.   end;
  194.   {}
  195.   begin TEST; end.
  196. --------------------------------------------------------------------
  197.  
  198. From ts@uwasa.fi Sun Apr 28 00:01:19 1996
  199. Subject: Substrings from a string
  200.  
  201. 79. *****
  202.  Q: How do I extract (parse) substrings from an input string?
  203.  
  204.  A: Carefully study these two routines which I have included in
  205.  23480 Apr 21 1996 ftp://garbo.uwasa.fi/pc/research/simirr11.zip
  206.  simirr11.zip Deriving IRR from ARR: A Simulation Testbench, TS+IV
  207. They use space (and anything in ascii below it) as the separator.
  208. Change the while tests if you wish to have a different set of
  209. separators.
  210.   (* Number of substrings in a string *)
  211.   function PARSENFN (sj : string) : integer;
  212.   var i, n, p : integer;
  213.   begin
  214.     p := Length(sj);
  215.     n := 0;
  216.     i := 1;
  217.     repeat
  218.       while (sj[i] <= #32) and (i <= p) do Inc(i);
  219.       if i > p then begin parsenfn := n; exit; end;
  220.       while (sj[i] > #32) and (i <= p) do Inc(i);
  221.       Inc(n);
  222.       if i > p then begin parsenfn := n; exit; end;
  223.     until false;
  224.   end;  (* parsenfn *)
  225.   {}
  226.   (* Get substrings from a string *)
  227.   function PARSERFN (sj : string; PartNumber : integer) : string;
  228.   var i, j, n, p : integer;
  229.       stash      : string;
  230.   begin
  231.     if (PartNumber < 1) or (PartNumber > PARSENFN(sj)) then
  232.       begin PARSERFN := ''; exit; end;
  233.     p := Length(sj);
  234.     n := 0;
  235.     i := 1;
  236.     repeat
  237.       while (sj[i] <= #32) and (i <= p) do Inc(i);
  238.       Inc(n);
  239.       if n = PartNumber then
  240.         begin
  241.           j := 0;
  242.           while (sj[i] > #32) and (i <= p) do
  243.             begin
  244.               Inc(j);
  245.               stash[0] := chr(j);
  246.               stash[j] := sj[i];
  247.               Inc(i);
  248.             end;
  249.           PARSERFN := stash;
  250.           exit;
  251.         end
  252.        else
  253.          while (sj[i] > #32) and (i <= p) do Inc(i);
  254.     until false;
  255.   end;  (* parserfn *)
  256.   {}
  257.   {... A separate, but useful function from the same package ...}
  258.   (* Delete trailing white spaces etc rubble from a string *)
  259.   function TRAILFN (sj : string) : string;
  260.   var i : byte;
  261.   begin
  262.     i := Length (sj);
  263.     while (i > 0) and (sj[i] <= #32) do i := i - 1;
  264.     sj[0] := chr(i); trailfn := sj;
  265.   end;  (* trailfn *)
  266.   {}
  267.   {... Another separate, but useful function from the same package ...}
  268.   (* Delete leading white spaces etc subble from a string *)
  269.   function LEADFN (sj : string) : string;
  270.   var i, p : byte;
  271.   begin
  272.     p := Length (sj); i := 1;
  273.     while (i <= p) and (sj[i] <= #32) do i := i + 1;
  274.     leadfn := Copy (sj, i, p-i+1);
  275.   end;  (* leadfn *)
  276. --------------------------------------------------------------------
  277.  
  278. From ts@uwasa.fi Sun Apr 28 00:01:20 1996
  279. Subject: Size of a file
  280.  
  281. 80. *****
  282.  Q: How do I find out the size of any kind of a file?
  283.  
  284.  A1: Well, to begin with the FileSize keyword and an example code
  285. are given in the manual (and help function of later TP versions) so
  286. those, as usual, are the first places to look at. But the example
  287. solution can be somewhat improved, and there is also an alternative
  288. solution. The FSIZEFN should never be applied on an open file.
  289.   function FSIZEFN (filename : string) : longint;
  290.   var fle    : file of byte;  { declare as a file of byte }
  291.       fmSave : byte;
  292.   begin
  293.     fmSave := FileMode;       { save the current filemode }
  294.     FileMode := 0;            { to handle also read-only files }
  295.     assign (fle, filename);
  296.     {$I-} reset (fle); {$I+}  { to do your own error detection }
  297.     if IOResult <> 0 then begin
  298.       fsizefn := -1; FileMode := fmSave; exit;
  299.     end;
  300.     fsizefn := FileSize(fle);
  301.     close (fle);
  302.     FileMode := fmSave;       { restore the original filemode }
  303.   end; (* fsizefn *)
  304.  
  305.  A2: The second, general alternative is
  306.   uses Dos;
  307.   function FSIZE2FN (FileName : string) : longint;
  308.   var FileInfo : SearchRec;   { SearchRec is declared in the Dos unit }
  309.   begin
  310.     fsize2fn := -1;           { return -1 if anything goes wrong }
  311.     FindFirst (filename, AnyFile, FileInfo);
  312.     if DosError <> 0 then exit;
  313.     if (FileInfo.Attr and VolumeId = 0) and
  314.        (FileInfo.Attr and Directory = 0) then
  315.          fsize2fn := FileInfo.Size;
  316.   end;  (* fsize2fn *)
  317.  
  318.  A3: The third alternative is due to a Usenet posting by Wayne
  319. Hoxsie (hoxsiew@crl.com). This alternative is an instructive example
  320. of using file handles.
  321.   uses dos;
  322.   var f : file;
  323.   {}
  324.   function filelength (var f : file) : longint;
  325.   var
  326.     handle : ^word;
  327.     regs : registers;
  328.   begin
  329.     handle := @f;
  330.     fillchar (regs, SizeOf(regs), 0);   { just in case }
  331.     regs.ax := $4202;
  332.     regs.bx := handle^;
  333.     regs.cx := 0;
  334.     regs.dx := 0;
  335.     msdos(regs);
  336.     filelength := (longint(regs.dx) SHL 16)+regs.ax;
  337.   end;
  338.   {}
  339.   begin
  340.     assign(f,paramstr(1));
  341.     filemode := 0;  { read-only files too }
  342.     reset(f);
  343.     writeln(filelength(f));
  344.     close(f);
  345.   end.
  346. --------------------------------------------------------------------
  347.  
  348. From ts@uwasa.fi Sun Apr 28 00:01:21 1996
  349. Subject: Formatting graphics output
  350.  
  351. 81. *****
  352.  Q: How do I format graphics output like in textmode writeln?
  353.  
  354.  A: In the graphics mode the positioned text output procedure is
  355. OutTextXY (X ,Y : integer; TextString : string); It does not have
  356. the same output formatting capabilities as the write procedure. It
  357. only accepts the one TextString. Therefore all the output formatting
  358. must be done previously on the string. The Str procedure has such
  359. capabilities. The example below gives the rudiments.
  360.   uses Crt, Graph;
  361.   var grDriver : integer;
  362.       grMode   : integer;
  363.       ErrCode  : integer;
  364.       s, s1    : string;
  365.       v1       : real;
  366.   begin
  367.     grDriver := Detect;
  368.     InitGraph (grDriver, grMode, ' ');
  369.     ErrCode := GraphResult;
  370.     if ErrCode <> grOk then begin
  371.       Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
  372.     ClearDevice;
  373.     {}
  374.     { Writing text in the graphics mode }
  375.     { Set the drawing color }
  376.     SetColor (Yellow);
  377.     { Set the current background color }
  378.     SetBkColor (Black);
  379.     { Set style for text output in graphics mode }
  380.     SetTextStyle (DefaultFont, HorizDir, 2);
  381.     { Preprocess the text }
  382.     v1 := 2.345;
  383.     Str (v1 : 10:2, s1);
  384.     s := 'The first value is' + s1 + '.';
  385.     { Output the text }
  386.     OutTextXY (100, 30, s);
  387.     OutTextXY (100, 50, 'Press any key');
  388.     {}
  389.     repeat until KeyPressed;
  390.     {}
  391.     RestoreCrtMode;
  392.     writeln ('That''s all folks');
  393.     CloseGraph;
  394.   end.
  395. Besides not having the same output formatting capabilities OutTextXY
  396. and OutText procedures do not scroll the screen. If you wish to
  397. achieve such an effect, you will have to code it yourself step by
  398. step. You can see the effect in
  399.  111673 Oct 8 1993 ftp://garbo.uwasa.fi/pc/ts/tsdemo16.zip
  400.  tsdemo16.zip Assorted graphics demonstrations of functions etc
  401. Coding the scrolling is a straight-forward but a laborious task.
  402. Hence it is beyond this FAQ. The outline, however, is that you must
  403. keep track where on the screen you are. When you come to the bottom
  404. of your window you have to move the above region upwards before you
  405. output new text. You can move graphics regions using the ImageSize,
  406. GetImage and PutImage procedures.
  407.   As for readln-type input in a graphics mode, that is a complicated
  408. issue. You will have to build the input routine reading a character
  409. at a time with ReadKey. The rudiments of using ReadKey are shown in
  410. the first question of FAQPAS.TXT. The demo, referred to a few lines
  411. back, will show the effect.
  412. --------------------------------------------------------------------
  413.  
  414. From ts@uwasa.fi Sun Apr 28 00:01:22 1996
  415. Subject: Reading more than one key
  416.  
  417. 82. *****
  418.  Q: How do I detect if more than one standard key is pressed down?
  419.  
  420.  A: The example code below relies very heavily on a Usenet posting
  421. by Lou Duchez ljduchez@en.com who wishes to acknowledge Bill Seiler
  422. for the handling of ports. The KeyNrDown and TEST routines are by
  423. myself. Besides being a demonstration the TEST procedure can be used
  424. to get the scan codes of the different keys instead of relying on
  425. external documentation.
  426.   Uses Dos;
  427.   {}
  428.   var keydown: array[0..127] of boolean;   { status array }
  429.       oldkbdint: procedure;       { points to the "normal" keyboard handler }
  430.       port60h, port61h: byte;     { used within the interrupt for storage }
  431.   {}
  432.   { The replacement keyboard handler }
  433.   procedure newkbdint; interrupt;
  434.   begin
  435.     port60h := port[$60];
  436.     keydown[port60h and $7f] := (port60h <= $7f);
  437.     port61h := port[$61];
  438.     port[$61] := port61h or $80;
  439.     port[$61] := port61h;
  440.     port[$20] := $20;
  441.   end;
  442.   {}
  443.   { Get the scancode of the key pressed down, 128 for none }
  444.   function KeyNrDown : byte;
  445.   var i : byte;
  446.   begin
  447.     KeyNrDown := 128;
  448.     for i := 0 to 127 do if KeyDown[i] then KeyNrDown := i;
  449.   end;
  450.   {}
  451.   { Test by displaying the scan codes of the keys pressed }
  452.   procedure TEST;
  453.   var k, k1 : byte;
  454.   begin
  455.     k1 := 128;
  456.     repeat
  457.       k := KeyNrDown;
  458.       if k <> k1 then begin
  459.         write (k, ' ');
  460.         if (k1 = 30) and (k = 31) then writeln ('Pressed A and S ');
  461.         k1 := k;
  462.       end;
  463.     until k = $01; {escape}
  464.   end; {test}
  465.   {}
  466.   begin
  467.     { turn on the replacement keyboard handler }
  468.     fillchar(keydown, 128, #0);  { sets array to all "false" }
  469.     getintvec($09, @oldkbdint);  { record location of old keyboard int }
  470.     setintvec($09, @newkbdint);  { this line installs the new interrupt }
  471.     {}
  472.     TEST;
  473.     {}
  474.     { turn off the replacement keyboard handler }
  475.     setintvec($09, @oldkbdint);
  476.   end.
  477. --------------------------------------------------------------------
  478.  
  479. From ts@uwasa.fi Sun Apr 28 00:01:23 1996
  480. Subject: Volume Serial Number
  481.  
  482. 83. *****
  483.  Q: How can I read a disk's Volume Serial Number?
  484.  
  485.  A: The Volume Serial Number for disks was introduced in MS-DOS
  486. version 4.0. Here is an example code
  487.   uses Dos;
  488.   {}
  489.   (* Convert a longint to a hexadecimal string *)
  490.   function LHEXFN (decimal : longint) : string;
  491.   const hexDigit : array [0..15] of char = '0123456789ABCDEF';
  492.   var i         : byte;
  493.       hexString : string;
  494.   begin
  495.     FillChar (hexString, SizeOf(hexString), ' ');
  496.     hexString[0] := chr(8);
  497.     for i := 0 to 7 do
  498.       hexString[8-i] := HexDigit[(decimal shr (4*i)) and $0F];
  499.     lhexfn := hexString;
  500.   end;  (* lhexfn *)
  501.   {}
  502.   (* Get disk serial number. Requires MS-DOS 4.0+.
  503.      Else, or on an error, returns an empty string.
  504.      The default drive can be pointed to by using '0' *)
  505.   function GETSERFN (drive : char) : string;
  506.   type diskInfoRecordType =
  507.     record
  508.       infoLevel      : word;                   { zero }
  509.       serialNumber   : longint;                { DWORD actually }
  510.       volumeLabel    : array [1..11] of char;  { NO NAME if none present }
  511.       filesystemType : array [1..8] of char;   { FAT12 or FAT16 }
  512.     end;
  513.   var regs     : registers;
  514.       diskInfo : diskInfoRecordType;
  515.       serial   : string;
  516.   begin
  517.     getserfn := '';
  518.     if swap(DosVersion) < $0400 then exit;
  519.     FillChar (regs, SizeOf(regs), 0);
  520.     drive := UpCase (drive);
  521.     if drive <> '0' then if (drive < 'A') or (drive > 'Z') then exit;
  522.     regs.ah := $69;             { Interrrupt 21 function $69 }
  523.     regs.al := $00;             { subfunction: get serial number }
  524.     if drive <> '0' then
  525.       regs.bl := ord(drive) - ord('A') + 1
  526.       else regs.bl := 0;
  527.     regs.ds := Seg(diskInfo);   { the diskInfo address: }
  528.     regs.dx := Ofs(diskInfo);   { its segment and offset }
  529.     Intr ($21, regs);
  530.     if (regs.flags and FCarry) <> 0 then exit;  { CF is set on error }
  531.     serial := LHEXFN (diskInfo.serialNumber);
  532.     getserfn := Copy (serial, 1, 4) + '-' + Copy (serial, 5, 4);
  533.   end;  (* getserfn *)
  534.   {}
  535.   begin
  536.     writeln ('C: ', GETSERFN('C'));
  537.   end.
  538.  
  539.  A2: The second alternative has been modified from a posting by
  540. Robert B. Clark rclark@su1.in.net. I have also utilized INTERRUP.E
  541. from Ralf Brown's listing of interrupt calls
  542.  ftp://garbo.uwasa.fi/pc/programming/inter49b.zip
  543.   {}
  544.   uses Dos;
  545.   function GETSERFN2 (drive : char): longint;
  546.   var ParBlock : array [0..24] of char;  { IOCTL parameter block Table 0785 }
  547.       regs     : registers;
  548.       sernum   : longint;
  549.   begin
  550.     FillChar (ParBlock, SizeOf(ParBlock), 0);
  551.     FillChar (regs, SizeOf(regs), 0);
  552.     regs.ax := $440D;     { IOCTL - generic block device request }
  553.     if drive <> '0' then  { '0' points to the default drive }
  554.       regs.bl := ord(UpCase(drive)) - ord('A') + 1  { drive as byte }
  555.       else regs.bl := 0;
  556.     regs.ch := $08;       { block device IOCTL category code: disk drive }
  557.     regs.cl := $66;       { IOCTL minor code: get volume serial number }
  558.     regs.ds := Seg(ParBlock);   { Parameter block segment address }
  559.     regs.dx := Ofs(ParBlock);   { Parameter block offset }
  560.     MsDos (regs);         { Call interrupt $21 }
  561.     if regs.Flags and FCarry = 0 then
  562.       sernum := word(ord(ParBlock[4]) + ord(ParBlock[5]) shl 8) * 65536 +
  563.                 word (ord(ParBlock[2]) + ord(ParBlock[3]) shl 8)
  564.     else sernum := 0;
  565.     getserfn2 := sernum;
  566.   end;  (* getsetfn2 *)
  567.   {}
  568.   begin
  569.     writeln ('C: ', LHEXFN(GETSERFN2('0')));
  570.   end.
  571.  
  572.  A3: Setting a disk's serial number, instead of just reading it, is
  573. more complicated and will not be covered here. If you need it, the
  574. routine without source code is available (for floppies only for
  575. security reasons) as
  576.   "SETSER Set floppy's serial number (MsDos 4.0+)"
  577. in TSUNTK.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip
  578.  
  579. --------------------------------------------------------------------
  580.  
  581. From ts@uwasa.fi Sun Apr 28 00:01:24 1996
  582. Subject: Disabling the keyboard
  583.  
  584. 84. *****
  585.  Q: How can I disable and then enable the keyboard in my TP program?
  586.  
  587.  A: Here is the code. A warning! Don't experiment with ports. You
  588. can do real harm to your data and your computer if you do not know
  589. exactly what you are doing.
  590.   uses Dos, Crt;  { Crt only needed because of 'Delay' in the testing }
  591.   var i : byte;   { only needed in the testing }
  592.       NormalKeyboard : procedure;
  593.   {}
  594.   procedure DisableKeyboard; interrupt;
  595.   var port60, port61 : byte;
  596.   begin
  597.     port60 := Port[$60];  { KeyBoard controller data output buffer }
  598.     port61 := Port[$61];  { Keyboard controller port B }
  599.     Port[$61] := Port61 or $80;  { clear keyboard }
  600.     Port[$61] := Port61;
  601.     Port[$20] := $20;     { Programmable Intr. Contr. initialization }
  602.   end;
  603.   {}
  604.   begin
  605.     writeln ('Testing...');
  606.     GetIntVec ($09, @NormalKeyboard);
  607.     SetIntVec ($09, @DisableKeyboard);
  608.     write ('The keyboard is now disabled..');
  609.     for i := 1 to 5 do begin
  610.       Delay (1000);
  611.       write (i:2);
  612.     end; {for}
  613.     writeln;
  614.     SetIntVec ($09, @NormalKeyboard);
  615.     write ('The keyboard is now enabled...');
  616.     for i := 1 to 5 do begin
  617.       Delay (1000);
  618.       write (i:2);
  619.     end; {for}
  620.   end.
  621. --------------------------------------------------------------------
  622.  
  623. From ts@uwasa.fi Sun Apr 28 00:01:25 1996
  624. Subject: CD-ROM device name
  625.  
  626. 85. *****
  627.  Q: How do I get the character device name of the (first) CD-ROM?
  628.  
  629.  A: First the code for a quick and dirty method to find the
  630. character device name
  631.   function MSCDEXFN : string;
  632.   var s : string;
  633.       f : text;
  634.       i : byte;
  635.       fmSave : byte;
  636.   begin
  637.     mscdexfn := '';                  { To indicate not found }
  638.     fmSave := FileMode;              { Store the original file mode }
  639.     FileMode := 0;                   { Also if read-only }
  640.     Assign (f, 'c:\autoexec.bat');   { Browse the AUTOEXEC.BAT }
  641.     {$I-} Reset (f); {$I+}
  642.     if IOResult <> 0 then exit;      { AUTOEXEC.BAT not found }
  643.     while not eof(f) do begin        { Line by line }
  644.       readln (f, s);
  645.       for i := 1 to Length(s) do s[i] := Upcase(s[i]);
  646.       if Pos('MSCDEX', s) > 0 then begin      { Is this the line }
  647.         if Pos ('REM', s) = 1 then continue;  { Skip rem lines }
  648.         Close (f);
  649.         FileMode := fmSave;          { Restore the original mode }
  650.         i := Pos('/D:', s);          { Look for the switch }
  651.         if i = 0 then exit;          { Nah! }
  652.         i := i + 3;                  { Where the name should start }
  653.         if i > Length(s) then exit;  { Nothing there! }
  654.         s := Copy (s, i, 255);       { Rest of the line after /D: }
  655.         mscdexfn := s;
  656.         i := Pos (' ', s);
  657.         if i = 0 then exit;
  658.         mscdexfn := Copy (s, 1, i-1);
  659.         exit;                        { Don't close twice }
  660.       end; {if}
  661.     end; {while}
  662.     Close (f);
  663.     FileMode := fmSave;              { Restore the original mode }
  664.   end; (* mscdexfn *)
  665.  
  666.  A2: There is more general and orthodox solution to finding the
  667. character device name for the (first)m CD-ROM. This was kindly
  668. provided to me by Chris Rankin (rankin@shfax1.shef.ac.uk).
  669.   uses Dos;
  670.   function GetCDROMDevice : string;
  671.   const driver_name_len = 8;
  672.   type
  673.     sig     = array[1..6] of char;
  674.     siglet  = array[1..4] of char;
  675.     signum  = array[1..2] of char;
  676.     drvname = array[1..driver_name_len] of char;
  677.     driverstr = string[driver_name_len];
  678.   type
  679.     PCDROMDriver = ^TCDROMDriver;
  680.     TCDROMDriver = record
  681.                      NextDriver:         PCDROMDriver;
  682.                      DeviceAttr:         word;
  683.                      StrategyEntryPoint: word;
  684.                      INTEntryPoint:      word;
  685.                      DeviceName:         drvname;
  686.                      Reserved:           word;
  687.                      DriveLetter:        byte;
  688.                      Units:              byte;
  689.                    case byte of
  690.                      0: (SigLetters:     siglet;
  691.                          SigNumbers:     signum);
  692.                      1: (Signature:      sig)
  693.                    end;
  694.     TDriveEntry = record
  695.                     SubUnit: byte;
  696.                     Driver:  PCDROMDriver
  697.                   end;
  698.   var
  699.     DeviceList: array[1..26] of TDriveEntry;
  700.     Regs:       registers;
  701.     Name:       driverstr;
  702.   begin
  703.     with Regs do
  704.       begin
  705.         ax := $1500;
  706.         bx := 0;
  707.         intr($2f,Regs);      (* Ask for number of CD-ROM drives. *)
  708.         if bx = 0 then       (* If none, then exit.              *)
  709.           begin
  710.             Name[0] := #0;
  711.             GetCDROMDevice := Name;
  712.             exit
  713.           end;
  714.         ax := $1501;           (* Put information about each CD-ROM *)
  715.         es := seg(DeviceList); (*  into DeviceList[].               *)
  716.         bx := ofs(DeviceList);
  717.         intr($2f,Regs)
  718.       end;  (* Below: Name of first CD-ROM driver *)
  719.     Name := DeviceList[1].Driver^.DeviceName;
  720.     while Name[length(Name)] = ' ' do  (* Strip off trailing blanks.. *)
  721.       dec(Name[0]);
  722.     GetCDROMDevice := Name
  723.   end;
  724. --------------------------------------------------------------------
  725.  
  726. From ts@uwasa.fi Sun Apr 28 00:01:26 1996
  727. Subject: Ejecting CD-ROM
  728.  
  729. 86. *****
  730.  Q: How do I eject a CD-ROM using a Turbo Pascal program?
  731.  
  732.  A: The code for the ejection is given below. Note that it needs the
  733. MSCDEXFN function from the previous FAQ item.
  734.   uses Dos;
  735.   {}
  736.   procedure EJECT (charDev     : string;
  737.                    var ok      : boolean;
  738.                    var errCode : word);
  739.   var regs        : registers;
  740.       cdrom       : file;
  741.       cdCtrlBlock : byte;            { CD-ROM Control Block }
  742.       handle      : ^word;           { Handle referencing CD-ROM driver }
  743.   begin
  744.     Assign (cdrom, charDev);         { Character device for CD-ROM driver }
  745.     {$I-} Reset (cdrom); {$I+}       { Tackle errors yourself }
  746.     if IOresult <> 0 then begin      { Exit if file not found }
  747.       ok := false;
  748.       errCode := $FFFF;              { Your own arbitrary error code }
  749.       exit;
  750.     end;
  751.     FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
  752.     regs.ax := $4403;                { Function $44, subfunction $03 }
  753.     handle  := @cdrom;               { Establish the file handle }
  754.     regs.bx := handle^;
  755.     FillChar(CdCtrlBlock, SizeOf(CdCtrlBlock), 0);
  756.     CdCtrlBlock := $00;              { $00 eject disk; $05 close tray }
  757.     regs.ds := Seg(CdCtrlBlock);     { ds:dx CD-ROM control block }
  758.     regs.dx := Ofs(CdCtrlBlock);
  759.     MsDos (regs);                    { Call interrupt $21 }
  760.     {$I-} Close (cdrom); {$I+}
  761.     ok := regs.flags and FCarry = 0; { Success or not? }
  762.     errCode := regs.ax;              { $01 = invalid function }
  763.   end;                               { $05 = access denied }
  764.   {}                                 { $06 = invalid handle }
  765.   procedure TEST;                    { $0D = invalid data }
  766.   var ok : boolean;
  767.       code : word;
  768.   begin
  769.     EJECT ('K', ok, code);
  770.     if ok then writeln ('Success') else writeln ('Error ', code);
  771.   end;
  772.   {}
  773.   begin
  774.     TEST;
  775.   end.
  776.  
  777. My thanks are due to Miro Wikgren (wikgren@cc.helsinki.fi) who
  778. pointed out that the "handle referencing character device for CD-ROM
  779. driver" must be the name given when the CD-ROM driver is loaded in
  780. CONFIG.SYS and AUTOEXEC.BAT. I could not solve this problem without
  781. that help in comp.lang.pascal.borland. In fact the previous FAQ item
  782. was tackled only after the current FAQ item had been solved first.
  783.  
  784. A slightly different approach to the file handle by Miro
  785.   var cdrom : text; { CD-ROM is a character device }
  786.   handle    : word; { Handle: word, not a pointer }
  787.   :
  788.   handle  := TextRec(cdrom).handle;  { Use TP help for more on this }
  789.   regs.bx := handle;
  790.   :
  791.  
  792. Another solution can be found in
  793.  3427 Mar 15 1996 ftp://garbo.uwasa.fi/pc/turbopas/cdtips01.zip
  794.  cdtips01.zip Eject/Close/Lock/Unlock CD-ROM in TP for Win95, C.Rankin
  795. --------------------------------------------------------------------
  796.  
  797. From ts@uwasa.fi Sun Apr 28 00:01:27 1996
  798. Subject: Detecting ANSI.SYS
  799.  
  800. 87. *****
  801.  Q: How do I find out if the ANSI.SYS driver has been loaded?
  802.  
  803.  A: The source code of the relevant function is given below.
  804. However, this is not necessarily a good solution. First, it requires
  805. at least MS-DOS version 4.0. Second, there are other, compatible
  806. screen drivers like ZANSI.SYS. You probably are more interested if
  807. such a screen driver has been installed rather than if it is
  808. ANSI.SYS in particular. To find out if any compatible screen driver
  809. is operative use ISANSIFN from TSUNTG.TPU from
  810.  112570 Aug 16 1994 ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip
  811.  tspa3470.zip Turbo Pascal 7.0 real mode units for (real:-) programmers
  812.   uses Dos;
  813.   function ANSIOKFN : boolean;
  814.   var regs : registers;
  815.   begin
  816.     if swap(DosVersion) < $0400 then begin
  817.       writeln ('Error: MS-DOS 4+ required');
  818.       ansiokfn := false;
  819.       halt;
  820.     end;
  821.     FillChar (regs, SizeOf(regs), 0);
  822.     regs.ax := $1A00;
  823.     Intr ($2F, regs);
  824.     ansiokfn := regs.al = $FF;
  825.   end; (* ansiokfn *)
  826. --------------------------------------------------------------------
  827.  
  828. From ts@uwasa.fi Sun Apr 28 00:01:28 1996
  829. Subject: TP tutorial and books
  830.  
  831. 88. *****
  832.  Q: Where do I find Turbo Pascal tutorials and/or good textbooks?
  833.  
  834.  A: I'll list some useful sources. The first one (where also this
  835. item comes from) among other things contains a slightly outdated
  836. list of TP textbooks.
  837.  
  838.  ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip
  839.  tsfaqp.zip Common Turbo Pascal Questions and Timo's answers
  840.  
  841.  ftp://garbo.uwasa.fi/pc/turbopas/tptutr11.zip
  842.  tptutr11.zip Glenn Grotzinger's ascii-text Turbo Pascal Tutor
  843.  
  844.  ftp://garbo.uwasa.fi/pc/turbopas/tpr-book.zip
  845.  tpr-book.zip Electronic Turbo Pascal Reference freeware book
  846.  
  847.  ftp://garbo.uwasa.fi/pc/doc-net/faqclpb.zip
  848.  faqclpb.zip comp.lang.pascal.borland newsgroup Mini-FAQ
  849.  
  850. Furthermore, you should see the fine SWAG (SourceWare Archival
  851. Group's) collection of TP sources. Available from the /pc/turbopas
  852. directory at Garbo. For the current references to the SWAG files see
  853. ftp://garbo.uwasa.fi/pc/INDEX.ZIP.
  854.    Yet another useful source can be the Turbo Pascal WWW pages. You
  855. can find some of them by connecting to my WWW home page. Its address
  856. is http://uwasa.fi/~ts. Select my collection of HTTP links and
  857. proceed to the programming section on the link list.
  858. --------------------------------------------------------------------
  859.  
  860. From ts@uwasa.fi Sun Apr 28 00:01:29 1996
  861. Subject: Making an executable
  862.  
  863. 89. *****
  864.  Q: How do I make an executable of my Turbo Pascal source program?
  865.  
  866.  A: This is a typical beginner's frequent question which belies not
  867. having read the manual carefully. You DO have the manual, right? If
  868. you are using Turbo Pascal 7.0 this is explained on page 48 of the
  869. User's Guide in the paragraph "Choosing a destination". Here, in
  870. brief, is what you should do
  871.   Press F10 to go to the main menu (or press alt-C)
  872.   Choose Compile
  873.   Choose Destination Disk  (toggle with enter)
  874. To direct where the executable should go
  875.   Press F10 to go to the main menu (or press alt-O)
  876.   Choose Options
  877.   Choose Directories...
  878.   Edit the item EXE & TPU directory   (the destination directory)
  879. --------------------------------------------------------------------
  880.  
  881. From ts@uwasa.fi Sun Apr 28 00:01:30 1996
  882. Subject: Last byte of a file
  883.  
  884. 90. *****
  885.  Q: How can I quickly read the last byte of a file?
  886.  
  887.  A: Below is the code for a relevant procedure. It has a number of
  888. instructive details for you to look into. It is easy to expand this
  889. procedure into showing any byte counted from the end by substituting
  890. the 1 in Seek (f, fs-1) to the inverted position, and by taking care
  891. that the position is not outside the file.
  892.   procedure LASTBYTE (fname  : string; var lb : byte);
  893.   var f      : file;       { Use an untyped file designation }
  894.       fmSave : byte;       { To push and pop the FileMode }
  895.       fs     : longint;    { For file size }
  896.   begin
  897.     fmSave := FileMode;    { Push the original FileMode }
  898.     FileMode := 0;         { To enable reading also read-only files }
  899.     Assign (f, fname);
  900.     {$I-} Reset (f, 1); {$I+}     { Open file and set record size to 1 }
  901.     if IOResult <> 0 then begin
  902.       writeln ('Error opening file ', fname);
  903.       halt;
  904.     end;
  905.     fs := FileSize(f);     { Get the size of the file }
  906.     if fs = 0 then begin
  907.       writeln ('Empty file ', fname);
  908.       halt;
  909.     end;
  910.     Seek (f, fs-1);        { Position to the last byte of the file }
  911.     BlockRead (f, lb, 1);  { Read the value of the position into lb }
  912.     Close (f);             { Close the file }
  913.     FileMode := fmSave;    { Pop the original FileMode }
  914.   end; (* lastbyte *)
  915. --------------------------------------------------------------------
  916.  
  917. From ts@uwasa.fi Sun Apr 28 00:01:31 1996
  918. Subject: Leap year
  919.  
  920. 91. *****
  921.  Q: Is 2000 a leap year? What is the leap year algorithm?
  922.  
  923.  A: With the approaching turn of the century this question is
  924. becoming more and more common. Here is the algorithm in Turbo
  925. Pascal.
  926.  function ISLEAP (y : integer) : boolean;
  927.  begin
  928.    isleap := (y mod 4 = 0) and not ((y mod 100 = 0) and not (y mod 400 = 0));
  929.  end;  (* isleap *)
  930. My thanks are due to Dr. John Stockton and Associate Professor Seppo
  931. Pynnonen for confirming the result. In fact it was who John
  932. suggested adding this question to the FAQ.
  933.    There are several equivalent formulations achieving the same
  934. result. Also nested multi-line if statments could be used. The
  935. boolean statements are much more concise, even if not very easy to
  936. construct.
  937.    If you are interested calendar related questions here is one
  938. useful URL reference: ftp://login.dknet.dk/pub/ct/calendar.faq
  939. "Frequentely asked questions about calendars" by Claus Tondering.
  940. --------------------------------------------------------------------
  941.  
  942. From ts@uwasa.fi Sun Apr 28 00:01:32 1996
  943. Subject: Week number
  944.  
  945. 92. *****
  946.  Q: Does anybody have a program that gives the week number?
  947.  
  948.  A: This answer comes without source code just with a pointer to a
  949. TPU including a week number algorithm. There is a function
  950.  "WEEKNRFN Returns the week number for a given date"
  951. in the TSUNTE.TPU unit in my
  952.  112570 Aug 16 1994 ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip
  953.  tspa3470.zip Turbo Pascal 7.0 real mode units for (real:-) programmers.
  954. (The unit collection is also available for earlier TP versions.)
  955. --------------------------------------------------------------------
  956.  
  957. From ts@uwasa.fi Sun Apr 28 00:01:33 1996
  958. Subject: OutText, integers and reals
  959.  
  960. 93. *****
  961.  Q: How can I use OutText to write numbers in the graphics mode?
  962.  
  963.  A: OutText is the procedure to use for output in the graphics mode.
  964. The syntax of the procedure is OutText(TextString: string). You'll
  965. first have to convert a number into a string before you can output
  966. it with OutText. The example below shows how it can be done when the
  967. users wishes to output the integer value value of 12 and the result
  968. of 4/7 as a real with a suitable formatting. Generalization from
  969. thereon should be easy.
  970.   uses Crt, Graph;
  971.   var grDriver : integer;
  972.       grMode   : integer;
  973.       ErrCode  : integer;
  974.   const CharSize : integer = 2;
  975.   {}
  976.   function INT2STR (x : integer; ff : byte) : string;
  977.   var s : string;
  978.   begin
  979.     Str (x : ff, s);
  980.     int2str := s;
  981.   end;
  982.   {}
  983.   function REAL2STR (x : real; ff, dd : byte) : string;
  984.   var s : string;
  985.   begin
  986.     Str (x : ff : dd, s);
  987.     real2str := s;
  988.   end;
  989.   {}
  990.   begin
  991.     grDriver := Detect;
  992.     InitGraph (grDriver, grMode, ' ');
  993.     ErrCode := GraphResult;
  994.     if ErrCode <> grOk then begin
  995.       Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
  996.     SetColor (LightCyan);
  997.     SetBkColor (Black);
  998.     SetTextStyle(DefaultFont, HorizDir, CharSize);
  999.     {}
  1000.     {... this is the example's key line ...}
  1001.     OutText ('The values are: ' + INT2STR(12,2) + REAL2STR(4/7,10,3));
  1002.     {}
  1003.     MoveTo (0, 10*CharSize);
  1004.     OutText ('Press any key');
  1005.     repeat until KeyPressed;
  1006.     RestoreCrtMode;
  1007.     CloseGraph;
  1008.   end.
  1009. Naturally, the 12 in INT2STR(12,2) could as well be a variable
  1010. containing the value. Ditto for REAL2STR(4/7,10,3).
  1011. --------------------------------------------------------------------
  1012.  
  1013. From ts@uwasa.fi Sun Apr 28 00:01:34 1996
  1014. Subject: Ctr and output redirection
  1015.  
  1016. 94. *****
  1017.  Q: How can I redirect output to file if I use the Crt unit?
  1018.  
  1019.  A: First example:
  1020.   uses Crt;
  1021.   begin
  1022.     writeln ('This output cannot be redireted');
  1023.     assign (output, '');   { standard output }
  1024.     rewrite (output);
  1025.     writeln ('This output can be redirected');
  1026.   end.
  1027.  
  1028. Second example:
  1029.   uses Crt;
  1030.   var f: Text;
  1031.   begin
  1032.     Assign (f, '');
  1033.     Rewrite (f);
  1034.     Writeln (f, 'This output can be redirected');
  1035.     Close (f);
  1036.     AssignCrt (f);
  1037.     Rewrite (f);
  1038.     Writeln (f, 'This output cannot be redirected');
  1039.     Close(f);
  1040.   end.
  1041. --------------------------------------------------------------------
  1042.  
  1043. From ts@uwasa.fi Sun Apr 28 00:01:35 1996
  1044. Subject: In text or graphics mode
  1045.  
  1046. 95. *****
  1047.  Q: How to write a function to return true if I am in graphics mode?
  1048.  
  1049.  A: The ISGRFN in the example below returns true if the program
  1050. currently runs in the graphics mode and false in the text mode. For
  1051. more information see Ralf Brown's interrupt list part INTERRUP.A for
  1052. interrupt $10 functions $00 and $0F.
  1053.  
  1054.   uses Dos, Crt, Graph;
  1055.  
  1056.   (* The function to detect whether in video or text mode *)
  1057.   function ISGRFN : boolean;
  1058.   var regs : registers;
  1059.   begin
  1060.     FillChar (regs, SizeOf(regs), 0); { Just to make sure }
  1061.     regs.ah := $0F;                   { Function $0F gets video mode }
  1062.     Intr ($10, regs);                 { Call the video interrupt }
  1063.     case regs.al of
  1064.       $00,$01,$02,$03,$07 : isgrfn := false;  { is in text mode }
  1065.       else isgrfn := true;                    { is in graphics mode }
  1066.     end; {case}
  1067.   end;  (* isgrfn *)
  1068.  
  1069.   (* A procedure to turn the default graphics on *)
  1070.   procedure GRAPHON;
  1071.   var grDriver : integer;
  1072.       grMode   : integer;
  1073.       ErrCode  : integer;
  1074.   begin
  1075.     grDriver := Detect;
  1076.     InitGraph (grDriver, grMode, ' ');
  1077.     ErrCode := GraphResult;
  1078.     if ErrCode <> grOk then begin
  1079.       Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
  1080.     ClearDevice;
  1081.   end;  (* graphon *)
  1082.  
  1083.   (* Test in the text mode *)
  1084.   procedure TEST1;
  1085.   begin
  1086.     if ISGRFN then
  1087.       writeln ('In graphics mode')
  1088.       else
  1089.       writeln ('In text mode');
  1090.     writeln ('Press any key');
  1091.     repeat until KeyPressed;        { allow seeing the result }
  1092.     while KeyPressed do ReadKey;    { clear typeahead buffer }
  1093.   end;  (* test1 *)
  1094.  
  1095.   (* Test in the graphics mode *)
  1096.   procedure TEST2;
  1097.   begin
  1098.     GRAPHON;
  1099.     SetColor (Yellow);
  1100.     SetBkColor (Black);
  1101.     SetTextStyle (DefaultFont, HorizDir, 2);
  1102.     if ISGRFN then
  1103.       OutTextXY (100, 20, 'In graphics mode')
  1104.       else
  1105.       OutTextXY (100, 20, 'In text mode');
  1106.     OutTextXY (100, 50, 'Press any key');
  1107.     repeat until KeyPressed;               { allow seeing the result }
  1108.     while KeyPressed do ReadKey;           { clear typeahead buffer }
  1109.     RestoreCrtMode;
  1110.     CloseGraph;
  1111.   end;  (* test2 *)
  1112.  
  1113.   (* Main program *)
  1114.   begin
  1115.     TEST1;
  1116.     TEST2;
  1117.   end.
  1118. --------------------------------------------------------------------
  1119.  
  1120.